home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok58.lha / NPrint / txt / Print.mod < prev    next >
Text File  |  1993-08-15  |  18KB  |  747 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    Print
  4.     :Contents.   Formation of german text
  5.     :Author.     Oliver Schersand
  6.     :Address.    Schillerstr 4 7805 Bötzingen
  7.     :Phone.      07663/3049
  8.     :Copyright.  Public Domain
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga AMSoft 3.3d
  11.     :History.    V1.0 11.02.1991
  12.  
  13. **********************************************************************)
  14. (* $V- $R- $S- $F- *)
  15. MODULE Print;
  16.  
  17. FROM FileSystem  IMPORT Lookup,Close,ReadChar,File,Response,WriteChar,
  18.                         WriteBytes;
  19.  
  20. FROM Conversions IMPORT ValToStr,StrToVal;
  21.  
  22. FROM InOut       IMPORT Read,Write,WriteInt,WriteString,WriteLn,
  23.                         ReadString;
  24.  
  25. IMPORT InOut;
  26.  
  27. FROM Str         IMPORT FirstPos,Concat,Compare,Length,Copy;
  28.  
  29. FROM Arts        IMPORT Assert,Terminate,BreakPoint,TermProcedure;
  30.  
  31. FROM SYSTEM      IMPORT ADR,ADDRESS;
  32.  
  33. FROM Arguments   IMPORT GetArg,NumArgs;
  34.  
  35. FROM Trenne      IMPORT Trennstrich;
  36.  
  37. FROM StringForm  IMPORT CutBlanks,Indent;
  38.  
  39. FROM StringOps   IMPORT InsertChar,FindChar,DeleteSubString;
  40.  
  41. FROM ARP         IMPORT GetEnv,SetEnv;
  42.  
  43. IMPORT ASCII;
  44.  
  45. TYPE Entscheidung      = (ja,nein);
  46.      Ausgabe           = (rechtsb,linksb,block,zentriert);
  47.  
  48.      Commands = (reset,         (* Drucker resetten *)
  49.                  italicsOn,     (* Kursiv ein       *)
  50.                  underlineOn,   (* Unterstreichen ein *)
  51.                  boldOn,        (* fettdruck ein      *)
  52.                  plain,         (* Normalschrift      *)
  53.                  lq1,
  54.                  draft,
  55.                  elite,         (* Zeichenbreite elite 12 CPI *)
  56.                  pica,          (* 10 CPI                     *)
  57.                  small,         (* 15 CPI                     *)
  58.                  propOn,        (* proportionalschrift ein    *)
  59.                  propOff,
  60.                  schatten,      (* Schattenschrift ein        *)
  61.                  suOff,         (* Schatten und oder Umriss aus *)
  62.                  lrMargin,      (* Linker und Rechter Rand festlegen *)
  63.                  lowSpace,      (* 1/8 Zoll Zeilenabstand *)
  64.                  normSpace      (* 1/6 Zoll Zeilenabstand *)
  65.                  );
  66.  
  67.      Parameter = RECORD                       (* Druckeinstellungen *)
  68.                   rmarg,lmarg   : CARDINAL;
  69.                   pageoffset    : CARDINAL;
  70.                   pagelen       : CARDINAL;
  71.                   darst         : Ausgabe;
  72.                   trenne        : BOOLEAN;
  73.                   pagenumber    : BOOLEAN;
  74.                  END;
  75.  
  76. String = ARRAY[0..200] OF CHAR;
  77.  
  78. VAR Lese,Drucker   : File;    (* Externe Dateien *)
  79.  
  80.     ch              : CHAR;                  (* Letztes gelesende Zeichen *)
  81.     getBuffer       : ARRAY[0..255] OF CHAR; (* Puffer für Variabeln *)
  82.     getCount        : [0..255];              (* Position in Puffer *)
  83.  
  84.     art,
  85.     Wort,            (* aktuell gescanntes Wort *)
  86.     Datei : String;  (* aktuelle Eingabedatei (Toplevel) *)
  87.     dir   : BOOLEAN;
  88.  
  89.     Format           : Parameter;
  90.     Rest             : String;    (* Zeilenüberhang *)
  91.     breite,Zeile     : CARDINAL;  (* Zeilengröße    *)
  92.  
  93.    Konsonanten,Vokale,Trunc   : String; (* Für die Trennung *)
  94.  
  95.     Seite  : CARDINAL; (* Aktuelle Seite *)
  96.  
  97.    (* Variabeln für die Benutzerschnittstelle *)
  98.  
  99.    outx,outy : INTEGER;      (* Stelle an der Trennvorschlag erscheint *)
  100.    len       : INTEGER;
  101.  
  102.    FilePuffer : ARRAY[1..40] OF RECORD       (* Record für Dateistapel *)
  103.                                   f : File;
  104.                                   c : CHAR;
  105.                                 END;
  106.    FilePoint  : [1..40];    (* Maximal 40 Files tief verschachtelt *)
  107.  
  108.    gCom,                            (* Puffer für die Kommandos       *)
  109.    gPuffer : ARRAY[0..400] OF CHAR; (* Puffer für die aktuellen Zeile *)
  110.  
  111.    gStartupDatei : String;          (* Die Startup-Datei *)
  112.    gComPos,gPos : CARDINAL;         (* Position in den zwei Puffern *)
  113.  
  114.    FirstLine  : BOOLEAN;            (* Ob in erster Zeile einer Seite *)
  115.    EndOfFile  : BOOLEAN;            (* Ob letzer Buchstaben gelesen   *)
  116.  
  117. (*
  118.    Gibt Kommando in ein Zeichenpuffer und notiert ihre Stelle in der
  119.    Zeile
  120.  *)
  121.  
  122. PROCEDURE Com(com : Commands; a,b : INTEGER);
  123.  
  124.   PROCEDURE EscAndChar ( a : ARRAY OF CHAR);
  125.  
  126.   VAR i : INTEGER;
  127.  
  128.   BEGIN
  129.      gCom[gComPos] := CHAR(27); INC(gComPos);
  130.      FOR i := 0 TO Length(a)-1 DO
  131.        IF a[i] # " " THEN gCom[gComPos] := a[i]; INC(gComPos); END;
  132.      END;
  133.   END EscAndChar;
  134.  
  135. VAR res : CARDINAL;
  136.  
  137. BEGIN
  138.  res := gComPos;
  139.  gCom[res+1] := CHAR(gPos); INC(gComPos,2);
  140.  CASE com OF
  141.    reset        : WriteChar(Drucker,CHAR(27));WriteChar(Drucker,"c") |
  142.    italicsOn    : EscAndChar("[3m")    |
  143.    underlineOn  : EscAndChar("[4m")    |
  144.    plain        : EscAndChar("[0m")    |
  145.    boldOn       : EscAndChar("[1m")    |
  146.    lq1          : EscAndChar('[2"z')   |
  147.    draft        : EscAndChar('[1"z')   |
  148.    elite        : EscAndChar("[2w")    |
  149.    pica         : EscAndChar("[0w")    |
  150.    small        : EscAndChar("[4w")    |
  151.    schatten     : EscAndChar('[6"z')   |
  152.    suOff        : EscAndChar('[5"z')   |
  153.    lowSpace     : EscAndChar("[0z")    |
  154.    normSpace    : EscAndChar("[1z")    |
  155.  END;
  156.  IF gComPos - res  < 3 THEN
  157.    gComPos := res
  158.  ELSE
  159.    gCom[res] := CHAR(gComPos - (res+2));
  160.    gCom[gComPos] := 0C;
  161.  END;
  162. END Com;
  163.  
  164. (* Ende eines Includes *)
  165.  
  166. PROCEDURE TestEndFile() : BOOLEAN;
  167.  
  168. BEGIN
  169.  IF FilePoint = 1 THEN RETURN TRUE END;
  170.  Close(FilePuffer[FilePoint].f);
  171.  DEC(FilePoint);
  172.  Lese := FilePuffer[FilePoint].f;
  173.  ch   := FilePuffer[FilePoint].c;
  174.  RETURN FALSE
  175. END TestEndFile;
  176.  
  177.  
  178. (* Liest aus Variablenpuffer oder Datei ein Zeichen *)
  179.  
  180. PROCEDURE get();
  181.  
  182. VAR i : INTEGER;
  183.  
  184. BEGIN
  185.  IF getCount # 0 THEN
  186.    ch := getBuffer[0];
  187.    FOR i := 1 TO getCount DO getBuffer[i-1] := getBuffer[i] END;
  188.    DEC(getCount);
  189.  ELSE
  190.    IF Lese.eof THEN
  191.      EndOfFile := TestEndFile();
  192.      IF EndOfFile THEN ch := " " END;
  193.    ELSE
  194.      ReadChar(Lese,ch);
  195.    END;
  196.  END;
  197. END get;
  198.  
  199. (* Liest ein Zeichen ein überliest überzählige Leerzeichen *)
  200.  
  201.  
  202. PROCEDURE GetCh;
  203.  
  204. BEGIN
  205.  IF ch = " " THEN
  206.    REPEAT
  207.      get;
  208.      IF (ch < " ")  THEN ch := " " END;
  209.    UNTIL (ch # " ") OR (EndOfFile);
  210.  ELSE
  211.    get;
  212.    IF ch < " " THEN ch := " " END;
  213.  END;
  214. END GetCh;
  215.  
  216. (* Einlesen eines Wortes mit Trennzeichen am Ende des Wortes *)
  217.  
  218.  
  219. PROCEDURE ScanWord;
  220.  
  221. VAR i : INTEGER;
  222.     test : CHAR;
  223.  
  224. BEGIN
  225.  i := 0;
  226.  LOOP
  227.   Wort[i] := ch; INC(i);
  228.   IF (FirstPos(Trunc,0,ch)#-1) OR EndOfFile OR (ch<" ") THEN
  229.    IF i = 1 THEN GetCh ELSE DEC(i) END;
  230.    EXIT
  231.   END;
  232.   GetCh;
  233.  END;
  234.  Wort[i] := 0C;
  235. END ScanWord;
  236.  
  237.  
  238. (* Transferiert Variabel in eine Puffer von GetChar *)
  239.  
  240. PROCEDURE GetVariable();
  241.  
  242. VAR Puffer : String;
  243.     len,i  : LONGINT;
  244.     erg    : POINTER TO String;
  245.  
  246. BEGIN
  247.  erg := GetEnv(ADR(Wort),ADR(Puffer),200);
  248.  i := 0;
  249.  REPEAT getBuffer[getCount] := erg^[i]; INC(i); INC(getCount) UNTIL erg^[i] = 0C;
  250. END GetVariable;
  251.  
  252. (* Scanned Wort ein und includet wenn nötig eine Variable *)
  253.  
  254. PROCEDURE VScan();
  255.  
  256. BEGIN
  257.  ScanWord();
  258.  IF Wort[0] = "$" THEN ScanWord; GetVariable(); ScanWord(); END;
  259. END VScan;
  260.  
  261.  
  262. (* Includet eine neue Datei *)
  263.  
  264. PROCEDURE NewFile;
  265.  
  266. VAR Test   : File;
  267.  
  268. BEGIN
  269.  
  270.  VScan; VScan;
  271.  Lookup(Test,Wort,1024,FALSE);
  272.  IF Test.res = done THEN
  273.    FilePuffer[FilePoint].f := Lese;
  274.    FilePuffer[FilePoint].c := ch;
  275.    INC(FilePoint);
  276.    Lese := Test;
  277.    GetCh;
  278.  ELSE
  279.   WriteString("Datei:");WriteString(Wort);WriteString(" nicht gefunden!");
  280.   WriteLn;
  281.  END;
  282. END NewFile;
  283.  
  284. PROCEDURE GetCom;
  285.  
  286. VAR add,len : LONGINT;
  287.     puff    : String;
  288.  
  289.    PROCEDURE GetVal(VAR l : LONGINT);
  290.  
  291.    VAR  err,sgn : BOOLEAN;
  292.  
  293.    BEGIN
  294.     REPEAT
  295.     VScan;
  296.     UNTIL ("0" <= Wort[0]) AND (Wort[0] <= "9") OR EndOfFile;
  297.     StrToVal(Wort,l,sgn,10,err);
  298.    END GetVal;
  299.  
  300. BEGIN
  301.  ScanWord;
  302.  IF    Compare(Wort,"bold")=0 THEN
  303.   Com(boldOn,0,0)
  304.  ELSIF Compare(Wort,"i")=0 THEN
  305.   NewFile;
  306.  ELSIF Compare(Wort,"draft")=0 THEN
  307.   Com(draft,0,0);
  308.  ELSIF Compare(Wort,"pica") = 0 THEN
  309.    Com(pica,0,0)
  310.  ELSIF Compare(Wort,"reset") = 0 THEN
  311.    Com(reset,0,0)
  312.  ELSIF Compare(Wort,"elite") = 0 THEN
  313.    Com(elite,0,0)
  314.  ELSIF Compare(Wort,"small") = 0 THEN
  315.    Com(small,0,0)
  316.  ELSIF Compare(Wort,"lowSpace") = 0 THEN
  317.    Com(lowSpace,0,0)
  318.  ELSIF Compare(Wort,"normSpace") = 0 THEN
  319.    Com(normSpace,0,0)
  320.  ELSIF Compare(Wort,"shadow") = 0 THEN
  321.    Com(schatten,0,0)
  322.  ELSIF Compare(Wort,"shadowOff") = 0 THEN
  323.    Com(suOff,0,0)
  324.  ELSIF Compare(Wort,"underline")=0 THEN
  325.   Com(underlineOn,0,0)
  326.  ELSIF Compare(Wort,"italics")=0 THEN
  327.   Com(italicsOn,0,0)
  328.  ELSIF Compare(Wort,"plain")=0 THEN
  329.   Com(plain,0,0);
  330.  ELSIF Compare(Wort,"lq1")=0 THEN
  331.   Com(lq1,0,0);
  332.  ELSIF Compare(Wort,"center")=0 THEN
  333.   Format.darst := zentriert
  334.  ELSIF Compare(Wort,"leftjustify")=0 THEN
  335.    Format.darst := linksb;
  336.  ELSIF Compare(Wort,"rightjustify")=0 THEN
  337.   Format.darst := rechtsb;
  338.  ELSIF Compare(Wort,"fulljustify")=0 THEN
  339.   Format.darst := block;
  340.  ELSIF Compare(Wort,"pagenumber")=0 THEN
  341.   Format.pagenumber := TRUE;
  342.   Seite := 1;
  343.  ELSIF Compare(Wort,"lrmargin")=0 THEN
  344.   GetVal(len);
  345.   GetVal(add);
  346.   Format.lmarg := len;
  347.   Format.rmarg := add;
  348.   breite := add - len;
  349.   IF breite < 10 THEN
  350.     WriteString("Grenzen falsch gewählt:");WriteInt(len,10);WriteInt(add,10);
  351.     WriteLn;
  352.     breite := 10
  353.   END;
  354.  ELSIF Compare(Wort,"pagelen")=0 THEN
  355.   GetVal(len);
  356.   Format.pagelen := len;
  357.  ELSIF Compare(Wort,"pageoffset")=0 THEN
  358.   GetVal(len);
  359.   Format.pageoffset := len;
  360.  ELSIF Compare(Wort,"trenne") = 0 THEN
  361.   Format.trenne := TRUE;
  362.  ELSIF Compare(Wort,"trenneAus") = 0 THEN
  363.   Format.trenne := FALSE;
  364.  ELSIF Compare(Wort,"newPage") = 0 THEN
  365.   Wort := "^ ";
  366.   Zeile := Format.pagelen+20;
  367.   RETURN;
  368.  ELSIF Compare(Wort,"s") = 0 THEN
  369.  
  370.    VScan;
  371.  
  372. (* Variablennamen *)
  373.  
  374.   VScan();
  375.   Copy(puff,Wort);
  376.   VScan;
  377.  
  378. (* Variablenwert *)
  379.  
  380.   VScan();
  381.   IF Wort[0] = '"' THEN
  382.     Wort[0] := ch;
  383.     add := 1;
  384.     REPEAT GetCh; Wort[add] := ch; INC(add) UNTIL Wort[add-1] = '"';
  385.     DEC(add);Wort[add] := 0C;
  386.     GetCh;GetCh;
  387.   END;
  388.  
  389.   IF NOT SetEnv(ADR(puff),ADR(Wort)) THEN
  390.     WriteString("Variable ");WriteString(puff);WriteString(" := ");
  391.     WriteString(Wort);WriteString(" nicht gesetzt.");WriteLn;
  392.   END;
  393.  
  394.  ELSE
  395.     CASE Wort[0] OF
  396.       | "$" : Wort[0] := 4C;
  397.       | "\" : Wort[0] := 3C;
  398.       | "^" : Wort[0] := 1C;
  399.       | "_" : Wort[0] := 2C;
  400.       | "{" : Wort[0] := 5C;
  401.       | "}" : Wort[0] := 6C;
  402.     ELSE
  403.      WriteString("Unbekanntes Kommando:");WriteString(Wort);WriteLn;
  404.      Wort[0] := 0C;
  405.     END;
  406.     RETURN
  407.  END;
  408.  Wort[0] := 0C;
  409.  IF ch = "|" THEN GetCh END;
  410. END GetCom;
  411.  
  412. PROCEDURE Scan;
  413.  
  414. BEGIN
  415.  ScanWord();
  416.  CASE Wort[0] OF
  417.    | "$" : ScanWord; GetVariable(); ScanWord();
  418.    | "\" : GetCom;
  419.  ELSE
  420.  END;
  421. END Scan;
  422.  
  423. PROCEDURE SeiteAusDrucker;
  424.  
  425. BEGIN
  426.  WriteChar(Drucker,CHAR(0CH));
  427. END SeiteAusDrucker;
  428.  
  429.  
  430. PROCEDURE Startseite;
  431.  
  432. VAR i,insert  : CARDINAL;
  433.     str       : String;
  434.     err       : BOOLEAN;
  435.  
  436. BEGIN
  437.  IF Format.pagenumber THEN
  438.    ValToStr(Seite,FALSE,str,10,5," ",err);
  439.    CutBlanks(str);
  440.    InsertChar(str,"-",0);InsertChar(str,"-",Length(str));
  441.    insert := Format.lmarg + (breite - Length(str)) DIV 2;
  442.    FOR i := 1 TO insert DO InsertChar(str," ",0) END;
  443.    FOR i := 0 TO Length(str)-1 DO
  444.      WriteChar(Drucker,str[i]);
  445.    END;
  446.  END;
  447.  FOR i := 1 TO Format.pageoffset DO WriteChar(Drucker,12C) END;
  448. END Startseite;
  449.  
  450.  
  451. PROCEDURE SendeZeile();
  452.  
  453. VAR i,j,pos,insert, len,offset : CARDINAL;
  454.     start : INTEGER;
  455.     ll : LONGINT;
  456.  
  457. BEGIN
  458.  
  459.  WITH Format DO
  460.  
  461. (* Berechnet den rechten Rand der Darstellung *)
  462.  
  463.    CutBlanks(gPuffer);
  464.    insert := lmarg;
  465.    len    := Length(gPuffer);
  466.  
  467.    CASE darst OF
  468.      | rechtsb    : insert := insert +  breite - len ;
  469.      | zentriert  : insert := insert + (breite - len) DIV 2;
  470.    ELSE
  471.    END;
  472.  
  473. (* fügt die Commandosequencen in den String ein *)
  474.  
  475.  
  476.   i := 0;offset := 0;
  477.   WHILE gCom[i] # 0C DO
  478.     len := INTEGER(gCom[i]); INC(i);
  479.     pos := INTEGER(gCom[i]) + INTEGER(offset); INC(i);
  480.     INC(offset,len);
  481.     IF pos > Length(gPuffer) THEN pos := Length(gPuffer) END;
  482.     INC(i,len);
  483.     FOR j := 1 TO len DO
  484.       DEC(i);
  485.       InsertChar(gPuffer,gCom[i],pos);
  486.     END;
  487.     INC(i,len);
  488.   END;
  489.  
  490. (* Macht dann wenn nötig Blocksatz *)
  491.  
  492.  
  493.   IF darst = block  THEN
  494.     IF len > (breite*2 DIV 3) THEN (* gibt zu große Lücken *)
  495.       start := 0;
  496.       IF FindChar(gPuffer," ",0) # -1 THEN
  497.         WHILE  len < breite DO      (* verteilt Lücken gleichmäßig *)
  498.           start := FindChar(gPuffer," ",start);
  499.           IF start = -1 THEN
  500.             start := FindChar(gPuffer," ",0);
  501.           END;
  502.           InsertChar(gPuffer," ",start);INC(start,2);
  503.           INC(len);
  504.         END;
  505.       END;
  506.     END;
  507.   END;
  508.  
  509. (* Sendet die Startlinie ergibt die möglichkeit in der ersten !! Zeile
  510.    kommandos wie in der Startupdatei zu plazieren
  511.    *)
  512.  
  513.    IF FirstLine THEN FirstLine := FALSE; Startseite() END;
  514.  
  515. (* Fügt rand ein und sendet das dann auf die Datei *)
  516.  
  517.    FOR i := 1 TO insert DO InsertChar(gPuffer," ",0) END;
  518.  
  519.    IF gPuffer[0] # 0C THEN
  520.      FOR i := 0 TO Length(gPuffer)-1 DO
  521.      CASE gPuffer[i] OF
  522.        |  1C : gPuffer[i] := "^";
  523.        |  2C : gPuffer[i] := "_";
  524.        |  3C : gPuffer[i] := "\";
  525.        |  4C : gPuffer[i] := "$";
  526.        |  5C : gPuffer[i] := "{";
  527.        |  6C : gPuffer[i] := "}";
  528.        | "_" : gPuffer[i] := " ";
  529.       ELSE
  530.       END;
  531.        WriteChar(Drucker,gPuffer[i]);
  532.      END;
  533.    END;
  534.  
  535.    gPos := 0;
  536.    gComPos := 0;
  537.    gPuffer[0] := 0C;
  538.    gCom[0]    := 0C;
  539.  END;
  540. END SendeZeile;
  541.  
  542. PROCEDURE Send (VAR daten : ARRAY OF CHAR);
  543.  
  544. VAR len,i    : LONGINT;
  545.  
  546. BEGIN
  547.  len := Length (daten);
  548.  i := 0;
  549.  WHILE i < len DO
  550.    gPuffer[gPos] := daten[i];
  551.    INC(i); INC(gPos);
  552.  END;
  553.  gPuffer[gPos] := 0C;
  554.  daten[0] := 0C;
  555. END Send;
  556.  
  557.  
  558. PROCEDURE Trenne (VAR wort : String;
  559.                       pos  : CARDINAL);
  560.  
  561. VAR i        : INTEGER;
  562.     buffer   : String;
  563.     buf      : CHAR;
  564.  
  565. BEGIN
  566.  IF (NOT Format.trenne) OR (pos < 4) THEN RETURN END;
  567.  Trennstrich(wort,"~");
  568.  DEC(pos,2);
  569.  
  570.  WHILE (pos>0) & (wort[pos]#"~") & (wort[pos]#" ") DO DEC(pos) END;
  571.  
  572.  IF pos > 1 THEN
  573.    wort[pos] := "-";
  574.    buf := wort[pos+1];
  575.    wort[pos+1] := 0C;
  576.    Copy(buffer,wort);
  577.    REPEAT
  578.      i := FindChar(buffer,"~",0);
  579.      IF i # -1 THEN
  580.        DeleteSubString(buffer,i,1);
  581.      END;
  582.    UNTIL i = -1;
  583.    Send(buffer);
  584.    wort[pos+1] := buf;
  585.    DeleteSubString(wort,0,pos+1);
  586.  END;
  587.  
  588.  REPEAT
  589.    i := FindChar(wort,"~",0);
  590.    IF i # -1 THEN
  591.      DeleteSubString(wort,i,1);
  592.    END;
  593.  UNTIL i = -1;
  594. END Trenne;
  595.  
  596.  
  597. PROCEDURE Druckezeile(VAR rest : String);
  598.  
  599. VAR i,Laenge,len  : LONGINT;
  600.     next          : ARRAY[0..1] OF CHAR;
  601.     buf           : CHAR;
  602.  
  603. BEGIN
  604.  next[0] := 12C; next[1] := 0C;
  605.  Wort := rest;
  606.  WHILE Wort[0] = " " DO DeleteSubString(Wort,0,1) END;
  607.  WHILE (Wort[0] = 0C) AND NOT EndOfFile DO
  608.    Scan;
  609.    WHILE Wort[0] = " " DO DeleteSubString(Wort,0,1) END;
  610.  END;
  611.  Laenge := Length(Wort);
  612.  len    := Length(Wort);
  613.  LOOP
  614.   IF Wort[0] = "^" THEN DEC(Laenge,len); Wort[0] := 0C; EXIT END;
  615.   IF NOT(Laenge <= LONGINT(breite)) THEN EXIT END;
  616.   Send(Wort);
  617.   Scan;
  618.   len := Length(Wort);
  619.   INC(Laenge,len);
  620.  END;
  621.  IF len >= Laenge THEN
  622.    FOR i := breite TO Laenge+1 DO
  623.      rest[CARDINAL(i)-breite] := Wort[i];
  624.    END;
  625.    Wort[breite] := 0C;
  626.    Send(Wort);
  627.  ELSIF Laenge > LONGINT(breite) THEN
  628.    DEC(Laenge,len);
  629.    Trenne(Wort,(breite-CARDINAL(Laenge)));
  630.    rest := Wort;
  631.  ELSE rest := 0C;
  632.  END;
  633.  SendeZeile();
  634.  WriteChar(Drucker,12C);
  635. END Druckezeile;
  636.  
  637. PROCEDURE LoadPrefs;
  638.  
  639. BEGIN
  640.  Lookup(Lese,gStartupDatei,5000,FALSE);
  641.  IF Lese.res = done THEN
  642.    WriteChar(Drucker,CHAR(27));WriteChar(Drucker,"c");
  643.    GetCh;
  644.    WHILE NOT EndOfFile DO
  645.      Scan;
  646.     END;
  647.     Close(Lese);
  648.  ELSE
  649.    WriteString("Startupdatei : ");WriteString(gStartupDatei);
  650.    WriteString(" nicht gefunden.");WriteLn;
  651.  END;
  652. END LoadPrefs;
  653.  
  654.  
  655. PROCEDURE DruckeText();
  656.  
  657. BEGIN
  658.  WriteString("Von ");WriteString(Datei);WriteString(" nach ");
  659.  WriteString(art);WriteLn;
  660.  Lookup (Drucker,art,5000,TRUE);
  661.  IF (Drucker.res = done) THEN LoadPrefs END;
  662.  Lookup (Lese,Datei,5000,FALSE);
  663.  IF (Lese.res = done) AND (Drucker.res = done) THEN
  664.    Rest[0] := 0C;
  665.    Seite := 1;
  666.    FirstLine := TRUE;
  667.    EndOfFile := FALSE;
  668.    Zeile := 1;
  669.    REPEAT
  670.      WHILE (Zeile < Format.pagelen) AND NOT EndOfFile DO
  671.        Druckezeile (Rest);
  672.        INC (Zeile);
  673.        Write(".");
  674.      END;
  675.      Write("|"); WriteLn;
  676.      SeiteAusDrucker;
  677.      INC (Seite);
  678.      Zeile := 1;
  679.      FirstLine := TRUE;
  680.    UNTIL EndOfFile;
  681.    Close (Drucker);
  682.    Close (Lese);
  683.    WriteString(" Drucken beendet.");WriteLn;
  684.  ELSE
  685.    IF Lese.res # done THEN
  686.      WriteString("Eingabedatei:");WriteString(Datei);
  687.      WriteString(" konnte nicht geöffnet werden");WriteLn;
  688.    ELSE
  689.      WriteString("Ausgabedatei:");WriteString(art);
  690.      WriteString(" konnte nicht geöffnet werden");WriteLn;
  691.    END;
  692.  END;
  693. END DruckeText;
  694.  
  695.  
  696. PROCEDURE Interactive();
  697.  
  698. BEGIN
  699.  LOOP
  700.    WriteString("Input  > "); ReadString(Datei);
  701.    WriteString("Output > "); ReadString(art);
  702.    IF (Datei[0]=0C) OR (art[0]=0C)  THEN EXIT END;
  703.    DruckeText();
  704.  END;
  705. END Interactive;
  706.  
  707. (*   ======================= Hauptprogramm ================================ *)
  708.  
  709. BEGIN
  710.  Konsonanten := "bcdfghklmnpqrstvwxyz";
  711.  Vokale      := "aeijouüäö";
  712.  Trunc       := ' |"(){}[];!?+^*#-§$%&\';
  713.  FilePoint   := 1;
  714.  gPos        := 0;
  715.  gComPos     := 0;
  716.  gCom[0]     := 0C;
  717.  getCount    := 0;
  718.  WITH Format DO
  719.    pagelen    := 60;
  720.    pageoffset := 0;
  721.    rmarg      := 80;
  722.    lmarg      := 0;
  723.    darst      := linksb;
  724.    trenne     := FALSE;
  725.    pagenumber := FALSE;
  726.  END;
  727.  breite := 80;
  728.  gStartupDatei := "s:Print-Startup.txt";
  729.  CASE NumArgs() OF
  730.    | 0 : Interactive()
  731.    | 1 : GetArg (1,gStartupDatei,len);Interactive()
  732.  
  733.    | 2 : GetArg (1,Datei,len);
  734.          GetArg (2,art,len);
  735.          DruckeText();
  736.  
  737.    | 3 : GetArg (1,gStartupDatei,len);
  738.          GetArg (2,Datei,len);
  739.          GetArg (3,art,len);
  740.          DruckeText();
  741.  
  742.  ELSE
  743.    WriteString("Zuviele Argumente!");WriteLn;
  744.    WriteString("[Startupdatei] [Input Output]");WriteLn;
  745.  END;
  746. END Print.
  747.